home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / MSGICONS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.3 KB  |  99 lines
  1. { msgicons.pas -- Display stock icons in message boxes }
  2.  
  3. program MsgIcons;
  4.  
  5. {$R msgicons.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects, Strings;
  8.  
  9. const
  10.  
  11.   id_Menu        = 100;   { Menu resource ID }
  12.  
  13.   cm_Asterisk    = 101;   { Menu-command IDs }
  14.   cm_Exclamation = 102;
  15.   cm_Hand        = 103;
  16.   cm_Information = 104;
  17.   cm_Question    = 105;
  18.   cm_Stop        = 106;
  19.  
  20. type
  21.  
  22.   MsgApplication = object(TApplication)
  23.     procedure InitMainWindow; virtual;
  24.   end;
  25.  
  26.   PMsgWindow = ^MsgWindow;
  27.   MsgWindow = object(TWindow)
  28.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  29.     procedure ShowMsg(P: PChar; MbType: Word);
  30.     procedure WMCommand(var Msg: TMessage);
  31.       virtual wm_First + wm_Command;
  32.   end;
  33.  
  34.  
  35. { MsgApplication }
  36.  
  37. {- Initialize MsgApplication object's window }
  38. procedure MsgApplication.InitMainWindow;
  39. begin
  40.   MainWindow := New(PMsgWindow, Init(nil, 'Msg'))
  41. end;
  42.  
  43.  
  44. { MsgWindow }
  45.  
  46. {- Construct MsgWindow object }
  47. constructor MsgWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  48. begin
  49.   TWindow.Init(AParent, ATitle);
  50.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu))
  51. end;
  52.  
  53. {- Display selected message box with icon }
  54. procedure MsgWindow.ShowMsg(P: PChar; MbType: Word);
  55. var
  56.   D: array[0 .. 35] of Char;
  57. begin
  58.   StrCopy(D, 'Message type = ');
  59.   StrCat(D, P);
  60.   MessageBox(HWindow, D, 'Message Box with Icon', MbType)
  61. end;
  62.  
  63. {- Intercept all wm_Command messages }
  64. procedure MsgWindow.WMCommand(var Msg: TMessage);
  65. begin
  66.   case Msg.WParam of
  67.     cm_Asterisk:
  68.       ShowMsg('mb_IconAsterisk', mb_IconAsterisk);
  69.     cm_Exclamation:
  70.       ShowMsg('mb_IconExclamation', mb_IconExclamation);
  71.     cm_Hand:
  72.       ShowMsg('mb_IconHand', mb_IconHand);
  73.     cm_Information:
  74.       ShowMsg('mb_IconInformation', mb_IconInformation);
  75.     cm_Question:
  76.       ShowMsg('mb_IconQuestion', mb_IconQuestion);
  77.     cm_Stop:
  78.       ShowMsg('mb_IconStop', mb_IconStop);
  79.   else
  80.     TWindow.WMCommand(Msg)
  81.   end
  82. end;
  83.  
  84. var
  85.  
  86.   MsgApp: MsgApplication;
  87.  
  88. begin
  89.   MsgApp.Init('MsgApp');
  90.   MsgApp.Run;
  91.   MsgApp.Done
  92. end.
  93.  
  94.  
  95. {--------------------------------------------------------------
  96.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  97.   Revision 1.00    Date: 3/07/1991
  98. ---------------------------------------------------------------}
  99.